00100	C   SCORB.F4   2ND HALF OF SCORE.
00200		SUBROUTINE RUNIT
00300		COMMON /Q/ BNW(100),NWZ /INS/INST(27),BG(60) /TYP/SOS,JOUT
00400		1 ,LN,ITYP,TPALN,JED
00500		COMMON/A/ V(2000),ROFF(27),NP(27),PCH(27,32),
00600		1 RDEV(27),IPT(27,31),XT(27),OTH(20,16),SCAL(101)
00700		1 ,P1(27),JFM(4),COPY(30),IFM(80)
00800		1 ,FINM(6),TINST(5),ENFI(5),TEDIT(4),INVIS(27)
00900		DIMENSION IV(2000),IT(30),IOUT(70),JPT(837),NCNT(27,32)
01000	C   WITH VX,IOUT AT 70 AND IFM AT 80 OK FOR ONLY 
01100	C   40 LIT CHARS + 30 PARAMS PER INST.
01200	C   60 BG TIMES AVAILABLE.  FOR INSTS AND INSERTS AND EDITS.
01300		COMMON P(30),J,L,CNT(27),BT,PL(48),MK,DF,DUR(27)
01400		1 ,IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
01500		1 ,INP(144),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
01600		COMMON/B/MOT,PR,T5,NINS,I,TP,RA,KZY,NWX,INONLY,MX,
01700		1 Y,Z,ISLAC,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,KB,NL,RC,W,
01800		1 CHN,YY 
01900		1 /D/TF,AMPFAC,OP1,DURX,IXIN,IFLNM
02000		1 /C/T,NWZZ,IT3,T6,NW,TDUR,A,T2,T4,IL,
02100		1 KODE,RD,LP,TBG,AC,NPA,BX,IDF,PM,NM,PAR,PX2,T1,NPAR,
02200		1 VIJ2
02300	C  /C/=26
02400		EQUIVALENCE (PP1,P(1)),(P(2),P2),(P(3),P3),(P(4),P4),
02500		1 (VX1,VX(1)),(INP1,INP(1)),(PL4,PL(4)),(IPT,JPT)
02600		1 ,(VX2,VX(2)),(VX3,VX(3)),(NCNT,PCH),(VX4,VX(4))
02700		1 ,(VX5,VX(5)),(VX,IOUT),(IFM3,IFM(3))
02800		1 ,(IT,INP(27)),(V,IV),(PLAY,ISCA(7)),(IFM2,IFM(2))
02900		1 ,(IFM4,IFM(4))
03000	      DATA SCAL/'C/8','CS/8','D/8','DS/8','E/8','F/8','FS/8','G/8',
03100		1 'GS/8','A/8','AS/8','B/8','C/4','CS/4','D/4','DS/4','E/4',
03200		1 'F/4','FS/4','G/4','GS/4','A/4','AS/4','B/4','C/2','CS/2',
03300		1 'D/2','DS/2','E/2','F/2','FS/2','G/2','GS/2','A/2','AS/2',
03400		1 'B/2','C','CS','D','DS','E','F','FS','G','GS','A','AS',
03500		1 'B','C*2','CS*2','D*2','DS*2','E*2','F*2','FS*2','G*2',
03600		1 'GS*2','A*2','AS*2','B*2','C*4','CS*4','D*4','DS*4','E*4',
03700		1 'F*4','FS*4','G*4','GS*4','A*4','AS*4','B*4','C*8','CS*8',
03800		1 'D*8','DS*8','E*8','F*8','FS*8','G*8','GS*8','A*8','AS*8',
03900		1 'B*8','R','F1','F2','F3','F4','F5','F6','F7','F8','F9',
04000		1 'F10','F11','F12','F13','F14','F15','END'/,I1X/'1X'/
04100		1 ,IFM(1)/'('/,IFM2/'1XA5,'/,IFCOM/5H', ',/,IA1/'A1,'/
04200		PR=0
04300	2337	T=0
04400		DO 1107 K=1,30
04500	1107	PL(K)=1.
04600	C  2/74--WAS AT 17300/1   SETS DEFAULT OUTPUT MODE TO 1.
04700		IF(ITYP)GO TO 23371
04800		END FILE 21
04900		DATA ENFI /25H(' INPUT ON FOR21.DAT '/)/
05000		TYPE ENFI
05100	C  PUTS AWAY TYPED IN DATA. TO REUSE, EDIT FOR21.DAT.
05300	23371	IF(SOS)WRITE(JOUT,902)
05400	C   WRITES A BLANK LINE
05500		NWZZ=0
05600		IAMP=0
05700		IT3=0
05800		K=1
05900	      IX=0  
06000		BG(NINS+1)=19999.
06100	4011	IF(CNT(K))GO TO 5011
06200	6011	IF(K.EQ.KZY)GO TO 4337
06300		K=K+1
06400		GO TO 4011
06500	5011	L=V(I-1)/(-9900.)
06600		IF(L.EQ.1)I=I-1
06700		V(I)=CNT(K)
06800		V(I+1)=P(K)
06900		V(I+3)=-44.
07000		I=I+5
07100		IF(P(K).EQ.980000.)I=I-4
07200		KL=I
07300		REWIND 1
07400		ICT=IPT(K,1)
07500		CALL IFILE(1,ICT)
07600	9011	L=I+6
07700		READ(1,7011)(V(M),M=I,L)
07800	C   READS "CONDUCT" AND "RHYTHM" (TAP) DATA.
07900		IF(V(L).EQ.999.)GO TO 8011
08000		I=L+1
08100		GO TO 9011
08200	8011	IF(P(K).NE.980000.)GO TO 6337
08300		DO 7337 K=L,I,-1
08400	7337	IF(V(K).NE.999.)GO TO 8337
08500	8337	I=K-1
08600		V(I)=0
08700		V(I+1)=V(K)
08800		V(I+2)=V(K)
08900	C   K WAS I-1 ABOVE.
09000		I=I+3
09100		V(KL+1)=I-KL-1
09200	C  ABOVE RESETS WORDCOUNT FOR 'CONDUCT' DATA.
09300		GO TO 4337
09400	6337	DO 5337 M=I,L
09500		KN=M
09600	5337	IF(V(M).EQ.999.)GO TO 3337
09700	3337	I=KN
09800		KN=I-KL
09900		V(KL-1)=KN
10000		V(KL-3)=KN+3
10100		GO TO 6011
10200	7011	FORMAT(7F)
10300	4337	IF(V(I-1).EQ.-9900.-BY)I=I-1
10400		V(I)=-19899.
10500	      PP1=0
10600	      T6=10000.   
10700	      DO 2118 K=1,NINS  
10800		ROFF(K)=0
10900	C********* FEB 17,71
11000		M=NP(K)
11100	      IT(K)=0 
11200		IPT(K,31)=0
11300		NCNT(K,31)=1
11400		DO 2118 L=1,M
11500		NCNT(K,L)=1
11600	2118	IPT(K,L)=0
11700		DO 5013 K=1,IXIN
11800	5013	X=RAND(0.0,0.0)
11900		REWIND 1
12000		IF(MX)CALL OFILE(1,ISLAC)
12100	      NW=1    
12200		NWX=0
12300	      TDUR=0
12400		A=0
12500	      T2=1. 
12600	      T4=1. 
12700	      T5=0  
12800		J=1
12900	      MK=0  
13000	C   IS THE ABOVE NEEDED?
13100		IF(MX.NE.3)GO TO 40021
13200		K=4
13300	10023	N=AMOD(V(K),100.0)/-11.
13400	C  AMOD NEEDED BECAUSE CODE # MAY HAVE -100 FOR DF OR -200 FOR SUBR.
13500		IF(N.EQ.2)GO TO 77
13550		IF(N.EQ.3)GO TO 77
13575		IF(N.NE.4)GO TO 10021
13600	77	IF(V(K-2).LT.10000.)GO TO 10021
13700		J=V(K+1)
13800		IF(J.EQ.1)GO TO 10024
13900		IF(N.NE.3)GO TO 177
13950		IF(V(K+J+1).EQ.101.)J=J-1
14000	177	N=V(K-2)
14100		L=N/10000
14200		M=N-L*10000
14300		TYPE 10022,INST(L),M,J
14400	10024	K=K+ABS(V(K-1))
14500	10021	K=K+1
14600		IF(K.LT.I)GO TO 10023
14700	40021	IF(MZ.NE.-4)GO TO 1002
14800		N=1
14900	40022	K=N+1
15000		IF(N.GT.I)CALL EXIT
15100		X=V(N)
15200		IF(X.EQ.-199.)GO TO 40024
15250		IF(X.EQ.-99.)GO TO 40024
15300		IF(X.GE.0)GO TO 40023
15400		PRINT 4002,X
15500		N=N+1
15600		GO TO 40022
15700	40024	J=N+1
15800		GO TO 40025
15900	C  FOR 'SECTIONS'
16000	40023	J=ABS(V(K))+K-1
16100	40025	PRINT 4002,(V(K),K=N,J)
16200		N=J+1
16300		GO TO 40022
16400	10022	FORMAT(1XA5,' P',I2,'  HAS ',I3,' ITEMS.')
16500	4002  FORMAT(10F12.3)
16600	1002	IF(IDALL)GO TO 600
16700		X=DUR(IDALL)
16800		DO 2002 K=1,NINS
16900	2002	IF(DUR(K))DUR(K)=X
     

00100	C ***** SORTER *************************  
00200	C  *******  OUTPUT LOOP FROM HERE ON  ********
00300	600      IL=0     
00400	C********** BELOW IS FOR 'SECTIONS'
00500		KODE=0
00600		NWX=NWX+1
00700	      MK=MK+1     
00800	      Y=BNW(NW)   
00900	723      IL=IL+1  
01000	3723      Z=V(IL)     
01100	      IF(Z.EQ.-19899.)GO TO 732
01200	      IF(Z.NE.-9900.-Y)GO TO 723     
01300	C********** BELOW IS FOR 'SECTIONS'
01400		IF(V(IL-2).EQ.-199.)KODE=IV(IL-1)
01500	2723      IL=IL+1   
01600	729	K=IL+2
01700		MOT=V(IL+1)
01800		RD=V(K)
01900		IF(RD.EQ.-67.)GO TO 3726
02000		RB=V(IL)
02100	C************ DOWN TO 4150 IS FOR 'SECTIONS'
02200		IF(RB.NE.-99.)GO TO 4150
02300		KODE=IV(K-1)
02400	2160	IF(KODE.EQ.0)GO TO 723
02500	  	IF(MZ)WRITE(JOUT,9150),KODE
02600		KL=Y/10000.
02700		RB=Y+KL*10000.
02800		DO 5150 KL=1,I
02900		IF(V(KL).NE.-199.)GO TO 5150
02950		IF(IV(KL+1).NE.KODE)GO TO 5150
03000		IV(K-1)=0
03100	C  WHEN 'PLAY' HAS BEEN FOUND, INDENTIFIER CHNGED TO 0
03200		RD=V(KL+2)+9900.
03300		DO 6150 L=KL+2,I
03400		M=V(L)/(-9900.)
03500		IF(M.NE.1)GO TO 6150
03600		RA=RB+RD-V(L)-9900.
03700		V(L)=-9900.-RA
03800	C  UPDATES BG TIMES INSIDE SECTION.
03900		CALL BGSORT(RA)
04000	C7150	IF(RA.EQ.BNW(KA))GO TO 6150
04100	C  UPDATES LIST OF CHANGE TIMES.
04200	6150	IF(V(L).EQ.-299.)GO TO 160
04300	5150	CONTINUE
04400	160	IL=1
04500		GO TO 3723
04600	C***********  ABOVE IS FOR 'SECTION' REPEATS
04700	4150	LK=RB/10000.+.2
04800		IF(LK.GE.98)GO TO 7700
04900		LP=RB-LK*10000
05000	C   LK=INST #   LP=PARAM #
05100		LN=IPT(LK,LP)
05200		IPT(LK,LP)=IL+2
05300		IF(RD.EQ.-66.)GO TO 726
05400		IF(RD.EQ.-55.)GO TO 1726
05450		IF(RD.EQ.-56.)GO TO 1726
05500		IF(RD.EQ.-23)GO TO 6700
05600	
05700	2727	ML=IPT(LK,LP)
05800		IF(MOT.GT.0)GO TO 3727
05900	C  USE NEG WDCNT FOR 'ALL'
06000		DO 4727 KL=LK+1,NINS
06100		IF(NP(KL).GE.LP)GO TO 277
06150		IF(LP.LT.31)NP(KL)=LP
06200	277	IPT(KL,LP)=-(LK+(LP-1)*KZY)
06300		NCNT(KL,LP)=10000
06400	4727	IF(DUR(KL))DUR(KL)=1000.
06500	C  ASSUMES THAT DURATIONS ARE SET IN 'NOTES'.
06600	C  AFTER 'ALL' IS USED ONCE IT WORKS LIKE DUPL OR REP.
06700		GO TO 727
06800	C 'MOVE' WITH 'ALL' KEEPS ORIGINAL TIME DATA REGARDLESS OF BG TIMES.
06900	3727	IF(V(IL).NE.V(LN-1))GO TO 727
06950		IF(LN.EQ.0)GO TO 727
07000		DO 1727 L=1,NINS
07100		DO 1727 KL=1,NP(L)
07200		IF(LN.NE.IPT(L,KL))GO TO 1727
07300		NCNT(L,KL)=10000
07400	C ******* JAN 29,70
07500		IPT(L,KL)=ML
07600	C RESETS POINTERS FOR DUPL AND REP INSTS.
07700	C *** 'ALL' WILL NOT WORK WITH RAN TF.!!!!!*******FEB 21,73
07800	1727	CONTINUE
07900	727	NCNT(LK,LP)=10000
08000	C******** MAY 13,71 RHY REP. FEATURE OMITTED.
08100	2150	IF(MOT)MOT=-MOT
08200		IL=IL+MOT+1
08300	3150	IF(V(IL))GO TO 3723
08400		GO TO 729
08500	726	RB=V(IL+3)
08600		K=RB/10000.
08700		L=RB-K*10000
08800		IPT(LK,LP)=-(K+(L-1)*KZY)
08900		GO TO 2727
09000	3726	LK=V(IL)
09100		M=V(K+1)
09200		KL=NP(M)
09300		DO 4726 L=1,KL
09400		IPT(LK,L)=IPT(M,L)
09500		IF(IPT(M,L).NE.0)NCNT(LK,L)=10000
09600	C****** JUN 29 71  (LK,L) WAS (L,K)....???????
09700	4726	CONTINUE
09800		IPT(LK,31)=IPT(M,31)
09900		K=0
10000		GO TO 2150
10100	C   ABOVE IS FOR DUPLICATION ROUTINE   NEXT ADJUSTS TIMES FOR 'RTAP'
10200	6700	KL=IL+V(IL+1)+1.3
10300		RC=V(K-2)
10400	1770	IF(V(KL))GO TO 700
10500	2700	KL=KL+V(KL+1)+1.3
10600		GO TO 1770
10700	700	KL=KL+1
10800		IF(Z.NE.V(KL-1))GO TO 2700
10850		IF(V(KL).NE.RC)GO TO 2700
10900		KL=KL+3
11000		KN=IL+3
11100		LN=V(KN)+.3
11200		DO 3700 L=1,LN,2
11300		RA=V(L+KN)
11400		KA=V(L+KN+1)+.3
11500		RB=0
11600		DO 4700 LP=1,KA
11700	4700	RB=RB+V(KL+LP)
11800		DO 5700 LP=1,KA
11900	5700	V(KL+LP)=V(KL+LP)/RB*RA
12000		V(KL+KA)=V(KL+KA)+.00030
12100	3700	KL=KL+KA
12200		GO TO 2150
12300	
12400	C  BELOW FOR 'TEMPO' SETUP
12500	7700	T2=V(IL+4)
12600		T1=V(IL+3)
12700		TBG=Y
12800		TDUR=V(IL+2)
12900		CALL SQYY(AC,T1,T2,TDUR)
13000	8700	IF(TDUR.EQ.0)TDUR=10000.
13100		T5=1.
13200		T6=TBG+TDUR
13300		IT3=1.
13400		IF(LK.EQ.98)IT3=IL+2
13500		T4=1.
13600		GO TO 2150
13700	C*************** ANY WDCNTS DOWN FROM HERE. *********
13800	C   NEXT ADJUSTS 'MOVE' TIMES IF BG IS AT A NOTE NUMBER.
13900	1726	IF(V(IL-1).GT.-19000.)GO TO 2727
14000		RA=BT
14100		K=IL-1
14200	2726	V(K)=-9900.-RA
14300		ISUB=-1
14400		L=K+5
14500		RB=V(L)+V(L-1)
14600		V(L-1)=RA
14700		K=K+V(K+2)+2
14800		IF(V(K).GT.-19000.)GO TO 2727
14850		IF(V(K+1).NE.V(IL))GO TO 2727
14900		IF(V(K).NE.-9900.-RB)GO TO 2727
15000		RA=RA+V(L)
15100		CALL BGSORT(RA)
15200		GO TO 2726
15300	C  CONVERTS BG TIME OF NOTE NUM TO REAL TIME.  DOESN'T WORK WITH -66!
15400	C   NOW WE BEGIN ON!! NOTE NUM. NOT AFTER NOTE NUM.
15500	732	DO 2606 K=NW,NWZ
15600	2606	BNW(K)=BNW(K+1)
15700		NWZ=NWZ-1
15800		IF(NWZ.EQ.0)GO TO 2111
15900		IF(NWZZ.EQ.1)GO TO 5111
16000		NWZZ=1
16100		IF(NWZ.EQ.1)GO TO 1111
16200		DO 3111 K=1,NWZ
16300		IF(BNW(K).LT.1000.)GO TO 3111
16400		X=BNW(NWZZ)
16500		BNW(NWZZ)=BNW(K)
16600		BNW(K)=X
16700		NWZZ=NWZZ+1
16800	3111	CONTINUE
16900	5111	IF(NWZZ.EQ.NWZ)GO TO 1111
17000		L=NWZZ+1
17100		X=BNW(NWZZ)
17200		DO 4111 K=L,NWZ
17300		IF(BNW(K).GT.X)GO TO 4111
17400		RA=BNW(K)
17500		BNW(K)=X
17600		X=RA
17700	4111	CONTINUE
17800		BNW(NWZZ)=X
17900		GO TO 1111
18000	111      FORMAT(1XA5,'.DAT',12X,'EDIT FILE NAME=',A5,8X,
18100		1'V ARRAY=',I4,'/2000',/' TEMPO FACTOR=',F6.2/)
18300	1023	FORMAT(/'  < ',A5,'.DAT  --  RANDOM NUMBER=',I6/1XA5)
18400	C********** BELOW IS FOR 'SECTIONS'
18500	9150	FORMAT(/3X'******* SECTION ',A1)
18600	2111	NWZ=-1
18700	C  ABOVE ORDERS BNW DATA TO SAVE TIME AT 1108 ON PG5.
18800	1111	IF(MZ.EQ.0)GO TO 1601
18900	      IF(NWX.NE.1)GO TO 1486
19000	      WRITE(JOUT,111)ISLAC,IFLNM,I,TF
19100	C*********** JUNE 1,71
19200	C********** BELOW IS FOR 'SECTIONS'
19300	1486	IF(KODE.NE.0)WRITE(JOUT,9150),KODE
19400		K=NWX-1
19500	C*********** JUNE 1,71
19600	        IF(NWX.LE.1)GO TO 377
19650		IF(IT(J).NE.-3)WRITE(JOUT,3154),K,Y  
19700	377	IF(IT(J).EQ.-3)WRITE(JOUT,5154),K,BX,INST(J) 
19800	C*********** JUNE 1,71    X 3     K'S
19900	
20000	      DO 602 K=1,NINS   
20100	48	LK=INST(K)
20200	C*********** JUNE 1,71
20300	  	IF(NCNT(K,31).EQ.10000)GO TO 477
20350		IF(NWX.GT.1)GO TO 602
20400	477	NCNT(K,31)=1
20500		IJ=IPT(K,31)
20600		X=0
20700		IF(IJ.NE.0)X=V(IJ+2)
20800	      WRITE(JOUT,5396),LK,X
20900		X=DUR(K)
21000	      IF(X.GT.10000.)GO TO 83 
21100	      WRITE(JOUT,8396),X     
21200		GO TO 602
21300	5396      FORMAT(5XA5,'  RANDOM TF =',F4.2,10X,'DURATION =',$) 
21400	7396      FORMAT('+',F5.0,' NOTES')    
21500	8396      FORMAT('+',F6.2,'"')   
21600	83      X=X-10000.
21700	      WRITE(JOUT,7396),X    
21800	602	CONTINUE
21900	715	IF(IT3.NE.1.)GO TO 1602
22000		RA=T1*TP
22100		RB=T2*TP
22200	      WRITE(JOUT,6154),RA,RB,TDUR  
22300	      IT3=0  
22400	1602	IF(NWX.EQ.1)GO TO 315
22500	      IF(IT(J).EQ.-3)GO TO 1108
22600	C*********** JUNE 1,71
22700	6154      FORMAT(' TMP=',F7.3,' TO',F8.3,' DURING',F6.2,' SECS.'/)
22800	7154	FORMAT(' ''CONDUCT'' FILE NAME = ',A5/)
22900	5154      FORMAT(/' << CHANGE',I3,' BEGINS ON NOTE',F5.0,1XA5,' >>'/)
23000	902      FORMAT(1XA5/)  
23100	3154      FORMAT(/' <<   BASIC TIME OF CHANGE',I3,' IS',F8.3,'" >>'/)
23200	4154      FORMAT(' THE FIRST',F9.4,'" ARE OMITTED'/)  
23300	C*********** JUNE 1,71
23400		IT(J)=IT(J)/10
23500		GO TO 1108
23600	315	IF(IT3.GT.1)WRITE(JOUT,7154),ICT
23700		IF(OP1.NE.0)WRITE(JOUT,4154),OP1 
23800	1601  IF(NWX.GT.1) GO TO 1108
24000		IF(TF.GT.10.)TF=TF/60.
24100		TF=1000./TF
24200		DO 6015 K=1,30
24300	6015	COPY(K)=-9900.
24400	C  INITS PARAM REPRESSION FEATURE.
24500	      IF(KB.EQ.0)GO TO 9926   
24600	      ML=NINS+1   
24700	      NL=NINS+KB
24800	      DO 9826 K=ML,NL   
24806	      BW=OTH(K-NINS,1) 
24810		IF(BW.NE.-99)GO TO 9826
24820		K=K-NINS
24830		GO TO 5741
24840	C  'INSERT -99;' COMES BEFORE 'PLAY;'
24850	9726	BW=19999.
24860		K=K+NINS
24870	9826	BG(K)=BW
25000	C   'OTH' INSERTS, WITH BG TIME IN SECONDS, CAN ONLY BE SET WITH TF=1   
25100	9926      DO 5015 K=1,NINS    
25200		IQ(K)=BG(K)*10000.
25300	      BG(K)=0
25400		INP(K)=0
25500	      P1(K)=0     
25600		IF(DUR(K).LT.10000.)DUR(K)=DUR(K)-.0001
25700	C******* FEB. 16,71   FOR ROUND-OFF NONSENSE
25800	5015      CNT(K)=0
25820		IF(MZ)WRITE(JOUT,1023),ISLAC,IXIN,PLAY
25900		IF(MX)WRITE(1,1023)ISLAC,IXIN,PLAY
26000	      BW=0 
26100		GO TO 500
     

00100	752      FORMAT(1X15A5)
00200	1108      M=0 
00300	      JC=0  
00400		IF(NWZ)GO TO 1740
00500	C  NWZZ IS SET AT 3111 IN SORTR.
00600		DO 740 K=1,NWZZ
00700	      X=BNW(K)    
00800		IF(X-.0001.GT.BT)GO TO 2740
00850		IF(X.LE.BW)GO TO 2740
00875		IF(BW)GO TO 2740
00900		IT(J)=IT(J)*10
01000	      NW=K  
01100	      GO TO 600   
01200	2740	IF(X.LT.1000.)GO TO 740
01250		IF(X-J*10000.NE.CNT(J)+1.)GO TO 740
01300	      X=BT+PR     
01400	      NW=K  
01500		BX=CNT(J)+1.
01600	      IT(J)=-3    
01700	      GO TO 600   
01800	740      CONTINUE 
01900	      IT(J)=0     
02000	1740      IF(J.LE.NINS)GO TO 31   
02100	7021      K=J-NINS
02200	      IF(JC.GT.0)K=JC   
02300	5740      IF(PP1.LT.OP1)GO TO 1752 
02400	5741  IF(MZ)WRITE(JOUT,752),(OTH(K,L),L=2,16)    
02500	      IF(MX)WRITE(1,752)(OTH(K,L),L=2,16)     
02600	C   IF TF .NE.1, ALL  INSERT TIMES MUST BE RESET
02700	C   IF FIRST PART OF NOTE LIST IS 'OMITTED', CHECK YOUR  'INSERTS'.  
02800		DO 17521 L=3,30
02900	17521	COPY(L)=-9900.
03000	C  SO THAT ALL PARAMS WILL PRINT,AFTER AN INSERT.
03100	1752	BG(K+NINS)=19999.
03200		OTH(K,1)=19999.
03210		IF(BW.EQ.-99)GO TO 9726
03300	      IF(JC.GT.0)GO TO 21     
03400	31      KL=1
03500	      IF(KB.EQ.0)GO TO 2031   
03600	      DO 1031 L=1,KB    
03700		K=L
03800	      X=OTH(K,1)-1000000.     
03900	      M=X/100000. 
04000	      IF(M.NE.J)GO TO 1031
04050		IF(IQ(J).NE.0)GO TO 1031   
04100	C   M=INST  
04200	      IF(X-M*100000.EQ.CNT(J)+1)GO TO 5740 
04300	1031	CONTINUE
04400		IF(J.GT.NINS)GO TO 500
04500	2031      CNT(J)=CNT(J)+1   
04600	      ICT=CNT(J)  
04700	C   INSERT TRAP HERE FOR OVERLAP OF RESTARTED INSTS.******
04800	      NPA=NP(J)   
04900	      PP1=P1(J)  
05000	      IF(BT.GE.DUR(J))GO TO 5174    
05100		IF(IQ(J).EQ.0)GO TO 200
05200		P2=-IQ(J)/10000.
05300		IQ(J)=0
05400		CNT(J)=-1
05500		ICT=-1
05600		GO TO 4203
05700	
05800	C   MK IS FLAG FOR RESTS
05900	200	MK=0
06000	      IF(BT.NE.0)GO TO 577
06025		IF(J.EQ.1)GO TO 203
06050	577	IF(IPT(J,1).EQ.0)GO TO 203    
06100		KN=IPT(J,1)-1
06200		IF(KN.GT.0)GO TO 12033
06300	12032	KN=JPT(-KN)
06400		IF(KN)GO TO 12032
06500		KN=KN-1
06600	C  FOR 'ALL' IN P32.  FOLLOWS UP ON POINTERS TO POINTERS!
06700	C   SOMEDAY PUT P1(32) IN WITH OTHER PARAMS BELOW!!!!
06800	12033	IJ=V(KN)
06900		IF(ABS(V(KN)).EQ.4.)GO TO 1203
07000	C   'IABS' IS FOR -4 USED WITH 'ALL'
07100	  	Z=(BT+9900.+V(KN-2))/V(KN+2)
07200	C******* FEB 19,71
07300		IF(Z.GT.1.)Z=1.
07400		Y=V(KN+3)
07500		X=(V(KN+4)-Y)*Z+Y
07600	C******* FEB 19,71
07700		GO TO 204
07800	1203	X=V(KN+3)
07900	204	Y=RAND(0.0,1.0)
08000		IF(Y-X)MK=-1
08100	
08200	203	DF=1.
08300	C   DF=DUTY FACTOR 
08400		DO 2155 L=2,NPA
08500		ISUB=0
08600	C  WHY DOES ISUB APPEAR AT 14700/5?
08700		IDF=0 
08800	C    IDF IS DUTY FACTOR FLAG
08900		IJ=IPT(J,L)
09000	12031	IF(IJ)IJ=JPT(-IJ)
09100		IF(IJ)GO TO 12031
09200	C  FOLLOWS UP ON POINTERS TO POINTERS!
09300		PM=1.
09400		IF(IJ.GT.1)GO TO 2157
09500		P(L)=0
09600		GO TO 21551
09700	C 7/73
09800	2157	LN=IJ+2
09900		NM=ABS(V(IJ-1))+LN-4
10000		NL=V(IJ)
10010		IF(NL.GT.-100)GO TO 272
10100		IF(NL.GT.-200)GO TO 372
10200		ISUB=-1
10300		NL=NL+200
10400	C FOR SUBROUTINE FLAG
10500	372	IF(NL.GT.-100)GO TO 272
10600		IDF=-1
10700		NL=NL+100
10800	C  DEC.6,72  FINDS DUTY FACTOR PARAM
10900	272	VIJ2=V(IJ+1)
11000		KN=NL/(-11)
11100		IF(KN.EQ.0)GO TO 1100
11200		GO TO (61,62,62,62,65,65,67,68),KN
11300	1100	IF(VIJ2.EQ.1.)GO TO 1200
11400		ML=3
11500	1900	KA=1
11600		VX1=0
11700		DO 1156 K=LN,NM,ML
11800		VX(KA+1)=V(K)+VX(KA)
11900	1156	KA=KA+1
12000		X=RAND(0.0,1.)
12100		DO 1157 K=2,11
12200		IF(X.GT.VX(K))GO TO 1157
12300		KL=K-1
12400		IF(KN.EQ.7)GO TO 6157
12500		GO TO 1400
12600	1157	CONTINUE
12700	1400	LN=IJ+3*KL
12800	1462	RA=V(LN)
12900		IF(RA.EQ.10000.)GO TO 5174
13000	C   FOR "FINE" IN RLIST
13100		RB=V(LN+1)
13200		PAR=RAND(RA,RB)
13300	1300	IF(NL.NE.-1)PM=2.
13400	C  IF 2 THEN PRINTS A5
13500		GO TO 1155
13600	1200	PAR=V(IJ+2)
13700		GO TO 1300
13800	C   NEXT IS FOR SUBROUTINE AND QUAD CALLS
13900	61	IF(NL.LT.-12)GO TO 6100
14000	601	X=P2
14100	C  '.5' MAKES ALL SUBR PARAMS PRINTOUT.
14200		CALL SUBR
14300	CC 7/74 NOW SET DUR(J) =0 IN SUBR	IF(DF)GO TO 5174
14400	C* OUT--COLGATE  DF=-1 IN 'SUBR' WILL CAUSE 'END' FOR INST.
14500		IF(L.EQ.2)GO TO 4203
14600		IF(X.EQ.P2)GO TO 21552
14700		PP2=P2
14800		PR=P2
14900		GO TO 21552
15000	C  ABOVE IS FOR P2 CHANGES IN SUBROUTINE
15100	C  TF,TEMPO,CONDUCT WILL AFFECT P2 ONLY WHEN P2 CALLS THE SUBR.,
15200	C  ALL 'TEMPO' CHANGES WILL BE IGNORED!! (THEN DUR. IN SECS. MUST
15300	C  BE SET TO 'REAL TIME'.)
15400	
15500	C   NEXT IS FOR QUAD ROUTINES
15600	6100	CALL QUAD(NL)
15700		GO TO 21552
15800	
15900	C   FOLLOWING IS FOR STRINGS OF VALUES.  
16000	62      KL=NCNT(J,L)+1
16100		IF(KL.GT.VIJ2)KL=1 
16200		IF(NL.EQ.-46)GO TO 677
16250		IF(NL.NE.-36)GO TO 162
16300	C   THIS PART FOR STRINGS OF RAND SELECTION
16400	677	LN=KL+IJ+1
16500		KL=KL+1
16600		IF(KL.GT.VIJ2)KL=1 
16700		NL=NL+45
16800	C   FOR NUMBERS ONLY SO FAR(THIS MAKES NL=-1.  FOR NOTES, =9)
16900	162	NCNT(J,L)=KL
17000		IF(NL.GT.-22)GO TO 1462
17100	C   JUMP RAND SELECTION
17200	      PAR=V(IJ+KL+1)
17300	C********** MAY 13,71 RHY REPEAT FEATURE OMITTED.
17400	C************************
17500		IF(KN.NE.3)GO TO 1155
17600	C*******JULY 16,71	IF(PAR.EQ.101.)GO TO 5174
17700		IF(PAR.EQ.10000.)GO TO 5174
17800		PM=2.
17900		IF(PAR.GT.100.)GO TO 777
17950		IF(PAR.GE.1.)GO TO 877
17975	777	PM=3.
18000	877	IF(PAR.EQ.85.)MK=-1
18100	      GO TO 5155  
18200	65	W=-9900.-V(IJ-3)
18300	C  W=BG TIME OF MOVE.
18400		X=ABS(V(IJ-1))
18500		IF(NL.EQ.-56)GO TO 977
18550		IF(NL.NE.-58)GO TO 771
18575	977	PM=2.
18600	771	Z=(BT-W)/VIJ2
18700	C  Z= % OF WAY THROUGH.
18800		IF(Z.GT.1.)Z=1.
18900		Y=V(LN)
19000		W=V(IJ+3)
19100		IF(X.EQ.7.)W=V(IJ+4)
19200		IF(NL.LT.-58)GO TO 16002
19300		PAR=(W-Y)*Z+Y
19400		IF(X.EQ.7.)GO TO 1600
19500		GO TO 1155
19600	C************** JUNE 1,71
19700	C   FOR "MOVX"
19800	C******** FEB/73
19900	C  THE .01 IS NEEDED FOR MOVE TO OR FROM 0.
20000	16002	PAR=RMOVX(W,Y,Z)
20100	C  SEE FUNCTION RMOVX 6/74 -- CAN'T HAVE -20→+20, ETC., -20→-40 OK.
20200	C  THIS NEEDS WORK!
20300		IF(X.NE.7.)GO TO 1155
20400		W=V(IJ+5)
20500		Y=V(IJ+3)
20600		X=RMOVX(W,Y,Z)
20700		GO TO 16003
20800	C  NEXT IS FOR MOVING RAND RANGES.
20900	C1600	PAR=(V(IJ+4)-Y)*Z+Y
21000	1600	W=V(IJ+3)
21100	C*********** BACK TO 65 IS NEW.   FEB. 15,71
21200		X=(V(IJ+5)-W)*Z+W
21300	C************ JUNE 1,71   
21400	16003	PAR=RAND(PAR,X)
21500		GO TO 1155
21600	67	LN=IJ+3
21700		NM=LN+VIJ2-1
21800		ML=1
21900		GO TO 1900
22000	4155	K=(PAR-9999.0)*100.+.1	
22100		P(L)=P(K)
22200		IF(L.NE.2)GO TO 772
22250		IF(K.EQ.2)P2=PX2
22300	C  PX2=LAST UNPROCESSED VALUE OF P2 (+ OR -) 7/74
22400	772	PM=PL(K)
22500		GO TO 21551
22600	C   ANY # OVER 9999. REPEATS ANOTHER PARAM.(9999.21 REPEATS P21)
22700	C 7/74  **** NOTE PROBLEMS OF P2 WITH SUBR, TEMPO, TF AND RAND. TF.
22800	C ALSO DF.  THE REAL TIME VALUE PRINTED MAY HAVE GONE THROUGH MANY
22900	C  CHANGES.  HENCE WHEN TRANSFERING THE VALUE TO OTHER PARAMS OR
23000	C  INSTS GREAT CARE MUST BE TAKEN TO BE SURE THE RESULTS ARE CORRECT.
23100	6157	LN=V(LN-1)
23200		DO 1068 K=1,KL
23300	1068	IF(K.LT.KL)LN=LN+V(LN)+1
23400	2068	PM=LN+1
23500		PAR=LN+V(LN)
23600		GO TO 5155
23700	68	KL=NCNT(J,L)
23800		IF(KL.EQ.0)GO TO 774
23850		IF(KL.NE.10000)GO TO 773
23875	774	KL=VIJ2
23900	773	PM=KL+1
24000		PAR=PM+V(KL)-1
24100		KL=PAR+1
24200		IF(V(KL).EQ.10000.)DUR(J)=BT
24300	C  'END' OR 'FINE' IN 'LIT' LIST.
24400		IF(V(KL).EQ.999.)KL=IJ+2
24500		NCNT(J,L)=KL
24600		GO TO 5155
24700	C ******* JAN 20  *************
24800	1155	IF(PAR.EQ.10000.)GO TO 5174
24900	C  TYPE 'END' OR 'FINE' AS LAST IN ANY STRING TO SET DURATION.
25000		IF(PAR.LE.9999.)GO TO 5155
25050		IF(PM.EQ.1.)GO TO 4155
25100	C****JULY 16,71 1155	IF((PAR.GT.9999.).AND.(PM.EQ.1.))GO TO 4155
25200	5155	P(L)=PAR
25300	21551	PL(L)=PM
25400		IF(ISUB)GO TO 601
25500		IF(L.EQ.2)GO TO 4203
25600	21552	IF(IDF.GE.0)GO TO 2155
25700		DF=PAR
25800	C DUTY FAC. IS ALWAYS % OF P2 - WHETHER CONSIDERING BASIC OR REAL TIME.
25900		IDF=0
26000	2155	CONTINUE
26100	
26200	9203      IF(KB.EQ.0)GO TO 1170     
26300	       NL=KB
26400	      DO 2203 K=1,KB    
26500	      X=OTH(NL,1) 
26600	      IF(X.LT.100000.)GO TO 2203     
26700	      L=X/100000.
26800	      Y=(X-L*100000.)/100.    
26900	      IX=Y  
27000	      JC=NL 
27100	      IF(J.NE.L)GO TO 2203
27150		IF(IX.EQ.ICT)GO TO 5203    
27200	2203  NL=NL-1     
27300	      GO TO 1170  
27400	4203      PR=P2 
27500		PX2=P2
27600	C TO SAVE THE UNPROCESSED P2 FOR 'P2 P2;' IN INPUT. 7/74
27700	      IF(T5.EQ.0)GO TO 7203   
27800		IF(IT3.LE.1)GO TO 6203
27850		IF(BT.LT.TBG+TDUR)GO TO 6203
27900	3155	IT3=IT3+3
28000		TBG=TBG+TDUR
28100		TDUR=V(IT3)
28200		IF(BT.GE.TBG+TDUR)GO TO 3155
28300		T1=V(IT3+1)
28400		T2=V(IT3+2)
28500		CALL SQYY(AC,T1,T2,TDUR)
28600	6203	RA=PR 
28700		IF(BT.EQ.TBG)XT(J)=T1
28800		K=IT3
28900		RC=0  
29000		RD=1  
29100		KA=1  
29200		RB=0  
29300		Z=TDUR+TBG-BT	
29400		X=T1  
29500		Y=T2  
29600		YY=AC
29700		CHN=TBG	
29800		ZZ=TDUR	
29900	      CALL ACCEL
30000	8203	P2=RA*RD    
30100	7203	P2=P2*T4
30200		X=P2*TF
30300	C  P2 IS KEPT WITHOUT TF*
30400		K=X+.5
30500		IF(X)K=X-.5
30600	72031	ROFF(J)=ROFF(J)+K-X
30700		IF(ABS(ROFF(J)).LT.1.)GO TO 7155
30800		Y=1.
30900		IF(ROFF(J))Y=-1.
31000		K=K-Y
31100		ROFF(J)=ROFF(J)-Y
31200	C  ROUND-OFF GAP WILL NOT EXCEED .001
31300	C*********** FEB 17,71
31400	7155	PP2=K/1000.
31500	C   AVOIDS ROUND-OFF PROBLEMS
31600	C AFTER ALL THIS P2 IN SUBR MAY NOT EQUAL PP2(REAL TIME) DF COMES LATER!
31700		IF(IPT(J,31).EQ.0)GO TO 6155
31800		IF(ICT)GO TO 1170
31900		X=V(IPT(J,31)+2)/2.
32000		Y=RAND(-X,X)
32100		IF(PP2.GE.0)GO TO 615
32200		MK=-1
32300		PP2=-PP2
32400	615	PP2=PP2-RDEV(J)+Y
32500		RDEV(J)=Y
32600	C  TOTAL RAND DEV. WON'T EXCEED P31
32700	C  SET P31 TO .0001 TO BRING VOICE BACK TO EXACT TIME(0 WON'T DO IT)
32800	
32900		K=PP2*1000.+.5
33000	C****** CHECK THIS OUT  1/10/72 :::::::
33100	61551	PP2=K/1000.
33200	C   NEVER MORE THAN .1( DEVIATION WITH RAN TF. (RTF=.05)
33300	6155	IF(ICT)GO TO 9203
33400		GO TO 2155
33500	5203      JD=Y*100-IX*100+.5  
33600	      IF(JD.GT.0)GO TO 3203   
33700		M=0
33800		P1(J)=PP1+PP2
33900	      GO TO 7021  
34000	3203      P(JD)=OTH(JC,2)     
34100		X=OTH(JC,3)
34200		IF(X.NE.1.)X=3.
34300	C   'EDITS' PRINT,NUM. OR 5 CHARS.
34400	      PL(JD)=X
34500	C   NEXT ADDED NOV.72  CHECK FOR SIDE AFFECTS !!!!! **********
34600		IF(JD.EQ.2)PP2=P2
34700	C   'TF' AND 'TEMPO' WILL NOT AFFECT PP2 'EDITS'.
34800	1170      IF(MK)GO TO 2022
34850		IF(PP2)GO TO 2022   
34900	
35000		ZPAR=PP1
35100		P1(J)=PP1+PP2
35200	C   ZPAR IS USED HERE WHEN OP1(OMIT) IS .GT.0. OMIT IS IN REAL TIME.
35300		LK=INST(J)
35400	2021	IF(PP1.LT.OP1)GO TO 2612
35500		IF(INVIS(J).LT.0)GO TO 2170
35600	C  ALL PARAMS WILL PRINT,1ST TIME WHEN USING 'OMIT'.
35700		IF(INONLY.GT.0)GO TO 1204
35800	C*********** MAY 16,71 ↑↑↑
35900	6021	IF(P(NPA).NE.COPY(NPA))GO TO 5021
35950		IF(PL(NPA).GT.1)GO TO 5021
36000	C******* MAY 25,71
36100	C  'LIT' DATA WILL ALWAYS PRINT.
36200		NPA=NPA-1
36300		IF(NPA.GT.2)GO TO 6021
36400	5021	DO 1304 K=3,NPA
36500	1304	COPY(K)=P(K)
36600	1204	IF(PL4.NE.1.)GO TO 2170
36700		P4=P4*AMPFAC
36800		L=0
36900		INP(J)=P4
37000		DO 1021	K=1,NINS
37100	1021	IF(P1(K).GT.PP1)L=L+INP(K)
37200		IF(L-IAMP-1)GO TO 2170
37300		IAMP=L
37400		AMPTIM=PP1
37500	2170	IF(MX.EQ.3)GO TO 2612
37600	C ********* MAY 17,71
37700	      PP1=PP1-OP1     
37800	C   PUTS SPACES BETWEEN NOTES .GT. .05( APART
37900		IF(MZ.NE.-1)GO TO 5170
37950		IF(A.GE.PP1)GO TO 5170
38000		IF(INONLY)WRITE(JOUT,902)
38100		A=PP1+.05
38200	5170	ML=10
38300		IF(NPA.LT.10)ML=NPA
38400		MLX=3
38500		NL=2
38600		IF(INVIS(J).EQ.0)GO TO 3170
38700		LK=0
38800	C  NEEDED TO INIT INVISIBLE MODE PRINT-OUT (NO INST NAME, P1, P2)
38900	C  NEXT CREATES FORMAT DATA IN IFM ARRAY.
39000	31701	KL=3
39100		GO TO 4170
39200	3170	IF(J.EQ.INONLY)GO TO 775
39250		IF(.NOT.INONLY)GO TO 2612
39300	775	VX(1)=PP1
39400		IF(DF.GT.0)GO TO 6170
39500		VX2=-DF
39600		IF(VX2.GT.PP2)VX2=PP2
39700	C NEG. DF=FIXED NOTE DUR. NOT.GT.PP2   7/74 COLGATE  -AND BELOW
39800		GO TO 7170
39900	6170	IF(DF.LT.100)GO TO 8170
40000	C DF>100 = FIXED REST AREA BEFORE NEXT ATTACK.
40100		VX2=PP2-DF+100.
40200		IF(VX2.LE.0)VX2=PP2/2.
40300	C NO NEG. TIME VALUES ALLOWED.
40400		GO TO 7170
40500	8170	VX2=PP2*DF
40600	7170	IFM3='F9.3,'
40700		IFM4=IFM3
40800		KL=5
40900		IF(NPA.LT.3)GO TO 2121
41000	
41100	4170	NL=2
41200		DO 1121 K=MLX,ML
41300		X=P(K)
41400		L=PL(K)
41500		IF(L-2)321,521,621
41600	C  L=1 NUMBS,  =2 NOTES,FUNCS,  =3 LITS.
41700	321	IF(X.GE.0)GO TO 4211
41800		IFM(KL)=IFCOM
41900		NL=NL+1
42000		KL=KL+1
42100	4211	IFM(KL)='F9.3,'
42200	C   CREATES 'F9.3'
42300	421	VX(KL-NL)=X
42400		GO TO 1121
42500	521	IFM(KL)=IFM2
42600	C   CREATES '1XA5'
42700		LN=X
42800		VX(KL-NL)=SCAL(LN)
42900		GO TO 42
43000	621	IF(L.GT.3)GO TO 721
43100		VX(KL-NL)=X
43200	C ABOVE LETS A5 WD BE USED IN SUBR BY SETTING PL(N)=3.
43300	42	IFM(KL)=IFM2
43400		GO TO 1121
43500	721	LN=X
43600		IFM(KL)=I1X
43700		NL=NL+1
43800		DO 821 M=1,LN-L+1
43900		KL=KL+1
44000		IOUT(KL-NL)=IV(L-1+M)
44100	821	IFM(KL)=IA1
44200	1121	KL=KL+1
44300	
44400	C  NO MORE THAN 80 ITEMS IN FORMAT.
44500	2121	IF(KL.LE.80)GO TO 21211
44600	21212	FORMAT(' ERROR! TOO MANY LIT. ITEMS')
44700		TYPE 21212
44800	21211	DO 921 M=KL+1,80
44900	921 	IFM(M)=IBLA
45000		IFM(KL)=')'
45100		L=KL-NL-1
45200		IF(MX)WRITE(1,IFM)LK,(VX(K),K=1,L)
45300		IF(.NOT.MZ)GO TO 30210
45400		IF(ML.GE.NPA)IFM(KL)='$)'
45500		WRITE(JOUT,IFM),LK,(VX(K),K=1,L)
45600	30210	IF(ML.GE.NPA)GO TO 3021
45700		MLX=ML+1
45800		ML=ML+10
45900		IF(ML.GT.NPA)ML=NPA
46000		LK=IBLA
46100		GO TO 31701
46200	3021	IF(MX)WRITE(1,3616)INST(J),ICT
46300	30211	IF(MZ)WRITE(JOUT,8902),J,INST(J),ICT,BT
46400	2612      PP1=ZPAR     
46500	         GO TO 21 
46600	8902	FORMAT('+;<'I2,1XA5,I4,' >',F7.3)
46700	3616	FORMAT(';PRINT(P1);< ',A5,I4)
46800	C   PRINTS RESTS  
46900	2022	PP2=ABS(PP2)
47000	C   IN THIS VERSION TYPE 'R' FOR RESTS IN ANY PARAM BUT P2. 
47100	C   FOR RESTS IN SEQS. TYPE -DUR.   
47200	C   WHEN RANDOM RESTS ARE CHOSEN, SEQS. MISS NOTES.
47300	C    RAN RESTS ARE TOUCHED BY SUBROUTINES ONLY BY SETTING IREST!!
47400		INP(J)=0
47500		P1(J)=PP1+PP2
47600	C   STORES NEXT P1 TIME FOR THIS INST.
47700		IF((MZ.NE.-1).OR.(PP1.LT.OP1))GO TO 21   
47800	      X=PP1-OP1  
47900		IF(A.GE.X)GO TO 121
48000		WRITE(JOUT,902)
48100		A=X+.05
48200	121	IF(INONLY.OR.J.EQ.INONLY)WRITE(JOUT,1110),INST(J),X,PP2,
48300		1 J,INST(J),ICT
48400	21	PR=ABS(PR)
48500	      BG(J)=BT+PR 
48600	      IF(ICT.EQ.DUR(J)-10000.)GO TO 5174 
48700	      IF(BG(J).LT.DUR(J))GO TO 500  
48800	5174      BG(J)=19999. 
48900	      DO 3174 K=1,NINS  
49000	C   INSERTS CANT FOLLOW LAST REGULAR NOTE.
49100	C   (ADD REST IF INSERT AT END IS NEEDED.)    
49200	3174      IF(BG(K).LT.19999.)GO TO 500     
49300	      GO TO 175   
49400	C   CHOOSES INST WITH NEXT BEGIN TIME.    
49500	500      J=1   
49600		BW=BT
49700	      NL=NINS+KB
49800	      DO 22 K=2,NL
49900	22      IF(BG(J).GT.BG(K))J=K 
50000		IF(J.GT.NINS.OR.NINS.EQ.1)GO TO 3022
50100		J=1
50200		DO 5022 K=2,NINS
50300		X=P1(J)
50400		Y=P1(K)+.0001
50500	C  LOWEST NUMBERED INST WILL COME 1ST IF BG TIMES ARE VERY CLOSE
50600		IF(BG(J).EQ.19999.)X=19999.
50700		IF(BG(K).EQ.19999.)Y=19999.
50800	5022	IF(X.GT.Y)J=K
50900	C   ABOVE IS FOR ROUND-OFF PROBLEMS WITH 'TEMPO' AND 'CONDUCT'.
51000	3022      BT=BG(J)    
51100	      IF((BT.EQ.19999.).OR.(P1(J).GE.DURX))GO TO 175
51200		IF(CNT(J).GT.0)GO TO 1022
51300	      IF(CNT(J).EQ.0)P1(J)=0  
51400	      IF(CNT(J).EQ.-1)CNT(J)=0
51500	C   N.B. 'TF' CONTROLS BG TIME WHEN BG .GT. 0   
51600	1022      IF((BT.LT.T6).OR.(IT3.GT.1))GO TO 1108    
51700	      T4=T2 
51800	      T5=0  
51900	      T6=10000.   
52000	      GO TO 1108    
52100	1175	FORMAT('+',A5,'=',F7.3,2X,$)
52200	1109	FORMAT(' FINISH; < ',A5,'.DAT')
52300	1110	FORMAT(' <',A5,2F9.3,2X,'******* REST <'I2,1XA5,I4)
52400	1603  FORMAT(' AMPL. FACTOR=',F4.2,', P4 MAX.AMP.=',I4,', AT TIME'
52500		1,F8.3)
52600	175	IF(MZ)WRITE(JOUT,1109),ISLAC
52700		IF(MX.GE.0)GO TO 4175
52800		WRITE(1,1109),ISLAC
52900		END FILE 1
53000	603	FORMAT(' TOTAL DURS:  ',$)
53100	CC FOR COLGATE ONLY***4175	CALL ENDSUB
53200	C  CLEARS CNTL O --- IF YOU HAVE HIT IT.
53300	4175	WRITE(JOUT,1603),AMPFAC,IAMP,AMPTIM
53400		WRITE(JOUT,603)
53500	5175	DO 2175 K=1,NINS
53600		X=P1(K)-OP1
53700		IF(MZ)GO TO 6175
53800		TYPE 1175,INST(K),X
53900		GO TO 2175
54000	6175	WRITE(JOUT,1175),INST(K),X
54100	2175	CONTINUE
54200	3175	TYPE 1023,ISLAC,IXIN
54300	      CALL EXIT
54400	      END